perm filename CHECKS[ALS,ALS] blob
sn#332565 filedate 1978-01-17 generic text, type T, neo UTF8
*CHECKERS REV of January 14 1977
*Resident package addresses
JOYT EQU H'0C00'
LINE EQU H'0FDF'
SHCB EQU H'0FE2'
INPF EQU H'0FE3'
WTLN EQU H'0FE5'
TXC EQU H'0FE8'
CMRG EQU H'0FEA'
DBNC EQU H'0FEB'
UPI EQU H'0FFA'
JOYI EQU H'21AD'
IJS EQU H'22DB'
SHL EQU H'27C6'
SHR EQU H'27D3'
PUSH EQU H'40A9'
POPS EQU H'40BC'
SPS EQU H'40D0'
WDG EQU H'4105'
WAUD EQU H'41C8'
WAU1 EQU H'41CC'
CDS EQU H'41D5'
WMS EQU H'4205'
UDAT EQU H'424D'
TRAN EQU H'43CD'
FCS EQU H'43D6'
WAIT EQU H'4501'
TIR EQU H'45DB'
SNE EQU H'46D6'
CLER EQU H'4762'
*Misc. constants
TCMD EQU H'44'
BCMD EQU H'6D'
TCOL EQU H'80' TEXT COLOR
ULIN EQU H'FA'
COM EQU H'8F7'
*RAM assignments
BFLG EQU H'0C20' BUTTON EDGE FLAG
BLNF EQU H'0C21' Blink flag
XBLN EQU H'0C22' X value to blink
YBLN EQU H'0C23' Y value to blink
BCNT EQU H'0C24' Counter used in OKMV
BKMV EQU H'0C25' Data to index book moves
HSAV EQU H'0C26' H save location
PLY0 EQU H'0C28' Place for player's ply depth choice
COL0 EQU H'0C29' Place for color choice(next after PLY0)
SELX EQU H'0C2A' SELE exit (0 norm, 1 M's 1st, -1 P's 1st)
AP20 EQU H'0C2C' ACTM+PASM+9 AT HL=20
XOLD EQU H'0C2D' XCOORD TOUCH POINT (DOUBLE JUMP)
YOLD EQU H'0C2E' YCOORD TOUCH POINT (DOUBLE JUMP)
OBJ0 EQU H'0C30' Board 1, thru H'0E0F'
TREE EQU H'0E10' Tree data, thru H'0EFF', Player's board f
TRE2 EQU H'0E20' Machine's first board here
TRE3 EQU H'0E3E' PASSED FLAG AT LEVEL 30
TRE4 EQU H'0E4E' PASSED FLAG AT LEVEL 40
PLDJ EQU H'0E57' USED FOR TEMP STORE OF TOUCH POINT
PLMD EQU H'0E5B' Used for temp store of player's move inf
PLMV EQU H'0ED0' Overlay region used for player's moves
PLMF EQU H'0EE0' and move numbers
SCRE EQU H'0EEE' Score reference address
SCOR EQU H'0EF2' SCORE (HI:LO) 14 2 BYTE PAIRS
XPOS EQU H'0F0C' XPOSITION(CURSOR)
YPOS EQU H'0F0F' YPOSITION(CURSOR)
OBJ1 EQU H'0F10' Board 2, thru H'0FAF'
MOBS EQU H'0FB0' Mobility (14 bytes)
RGSV EQU H'0FC8' Register save start (int. update)
*Scratch pad assignments
MAT EQU 0 REGISTER USED FOR MATERIAL
POT EQU 6 REGISTER USED FOR POSITION
HLS EQU H'4' REG TO SAVE HL OFFSET
TEMP EQU H'8'
J EQU H'9'
HU EQU H'A'
HL EQU H'B'
PLOC EQU O'3' LISU value for ACTIVE and PASSIVE
KLOC EQU O'4' LISU value for KING's and special data
ELOC EQU O'5' LISU value for EMPTY's area
ISA EQU O'30' ISAR value for active area
ISP EQU O'34' ISAR value for passive
ISK EQU O'40' ISAR value for kings
ACTM EQU O'46' ISAR VALUE FOR ACTIVE MATERIAL
PASM EQU O'47' ISAR VALUE FOR PASSIVE MATERIAL
ISE EQU O'51' ISAR value foempty (with offset)
*Mimimum ply depths
PLYA EQU H'F0' Playing depth for ABE (neg mob sum)
PLYB EQU H'E8' Playing depth for BETTY
PLYC EQU H'E0' Playing depth for CHARLIE
PLYD EQU H'D8' Playing depth for DOROTHY
*SPECIAL CONSTANTS
MSK EQU H'1' X ZOOM BIT MASK (CMRG)
X EQU H'1'
Y EQU H'2'
VX EQU H'3'
VY EQU H'4'
CHT EQU H'3' CURSOR HEIGHT
YTST EQU H'9'
XZOP EQU H'34' LINE FOR RESTORE OF X ZOOM
MAXY EQU H'4D' MAX Y COORD (=H'4F'-CHT)
*Linkage locations
ORG H'1000' Initial operations and questions
DC H'AA'
DC H'55'
DC H'01' BACKGROUND COLOR
DC H'00' BACKGROUND COLOR
DC H'00' SPACES
DC H'00' SPACES
DC H'3119' CH
DC H'0B31' EC
DC H'150B' KE
DC H'0921' RS
DC H'00' -
DC H'00' -
DC H'00' -
DC H'00' -
*-*-
DCI H'8F5'
CLR
ST SET BACKGROUND BLACK
PI CDS CLEAR DISPLAY
PI IJS INITIALIZE JOYSTICK TABLE
LISU 2 For safety only, can be removed later
LISL 6
CLR
XS S
BM QN1 Is clock running?
LI H'81' No, so start it
LR D,A
LIS 2
LR S,A
*-*-*-*- Initial question session
QN1 LIS H'5'
LR 0,A
PI SEDC SET MESSAGE LNGTH&LINE POINTER
DCI SKL
PI WMS WRITE MESSAGE
PI RKB AND DO KEYBOARD READ
CI H'2D'
BZ QN10 Is it Betty?
CI H'31' NO.
BZ QN9 Is it Charlie?
CI H'1F'
BZ QN8 Is it Dorothy
LI PLYA Then it's Abe
BR QN11
QN8 LI PLYD It's Dorothy
BR QN11
QN9 LI PLYC It's Charlie
BR QN11
QN10 LI PLYB It's Betty
QN11 DCI PLY0
ST AND SAVE IT.
DS 0
DS 0
DS 0 SET FOR BUT TWO LINES
PI CDS CLEAR DISPLAY
PI SEDC SET LINE POINTER
LIS H'5'
COM
AS S
LR S,A SET FOR BUT H'1A' LENGTH
DCI YMF DCO TO MESSAGE START
PI WMS SO WRITE MESSAGE
PI RKB READ KEYBOARD
CI H'2B' Is answer an N?
DCI COL0
CLR
LR 7,A Black plays first always
BZ QN13 N means machine first
COM
ST COL0<=-1, player is black
COM
ST SELX<=??, player first
BR QN14
QN13 ST COL0<=0, machine is black
ST SELX<=??, machine first
QN14 DCI BLKM TABLE OF POSSIBLE MOVES
XDC
DCI PLMV List to verify moves
LIS H'7'
LISU 2
LISL 0
LR S,A SET TRANSFER COUNT
PI TRAN DO TRANSFER
DCI BKMV
CLR
ST Clear Book move index value
DCI CMRG
LI H'65'
ST SET FOR X & Y ZOOM
PI CLER CLER UM1 REGISTERS
DCI UPI DCO TO UPDATE CONTROLS
LIS H'3'
ST SET INTO COUNT
CLR
ST SET FOR FULL INIT
LI INIT:
ST
LI INIT.
ST AND SET ADDRESS
PI WAUD WAIT, THEN UPDATE
LIS H'5'
LR S,A GET TRANSFER COUNT
DCI BDAT SET SOURCE
XDC INTO DC1
DCI UPI+1 DESTINATION
PI TRAN TRANSFER DATA
PI WAUD WAIT, DO UPDATE, RESET ISAR&RET.
PI ENIN NOW ENABLE INTERRUPT
*-*-*- Load SC for initial board
LISU PLOC LOAD SCRATCHPAD AS
LISL 7 FOLLOWS:
CLR
BRDJ LR D,A O'30'=FF
BR7 BRDJ O'31'=F0
COM O'32'=0
LR I,A O'33'=0
LR I,A O'34'=0
SL 4 O'35'=0
LR I,A O'36'=F
LISL 6 O'37'=FF
LIS H'F'
LR I,A
LISU KLOC
LISL H'7'
CLR
BRDK LR D,A O'40' thru O'47' = 0
BR7 BRDK
LI H'18' SET PASSIVE AND ACTIVE MATERIAL
LR D,A COUNTS TO H'18'=D'24' INITIALLY
LR D,A
DCI TRE2
PI SCRD SR to RAM for machine's first move
DCI TREE
PI SCRD SR to RAM for player's first move
PI BORD Generate board image with men
DCI XPOS
CLR
ST SET FOR LEFT MOST
LIS H'3'
ST
CLR
ST
DCI YPOS
ST AND SET FOR TOPMOST
*-*-*-*-*-*-*-*-*-*- Start play
DCI SCOR-2 Fix back-up score value
LI H'C1'
ST
LI H'C0'
ST
DCI COL0
CLR
XM
BM PMOV Player chose Black
*-*-*- Machine's first move if playing black
LISU 2
LISL 5
LIS H'7' Used as random number
NS S Save last 3 bits
LR 0,A Use this number to select move
DCI BKMV Book move index
SL 4 Save space for second move
SR 1
ST Record first move
DCI PLMV
QN17 LM Get byte record
LR 1,A
QN18 LR A,1
NS 1
BNZ QN19 Is this byte exhausted?
LM Step over byte info
BR QN17 Go to next byte record
QN19 LR 2,A
AI H'FF' Subtract 1
NS 1
LR 1,A byte less rightmost bit
XS 2 This leaves 1 bit in A
DS 0
BP QN18
LR 6,A Save the byte bit
LM Get the byte info
LR 4,A The byte indicator
DCI TRE2 Machine's board is here
LR H,DC
LIS H'C'
ADC
LR A,6
ST
LR A,4
ST
JMP SELE Go to SELE to make move
*Player's move
PMOV PI MWAD Wait, then update
PI MVC Initiate cursor
DCI TREE Player's board is here
LR H,DC
MES0 CLR "YOUR MOVE"
MES1 LR 0,A Identify message
PI WMC Write message
DCI BLNF
CLR
ST
CUR1 PI CURS Initiate cursor
*-*- Now X in 1, Y in 2, byte in 3 and byte # in 4
OKPI DCI PLMV Possible moves listing
OKP1 CLR
XM
BNZ OKP3 An entry found
LR A,5 Byte info
NI H'10' Extract J bit
LIS H'5' "PIECE CAN'T MOVE"
BZ OKP2
LIS H'1' "MUST JUMP"
OKP2 BR MES1 Try again
OKP3 NS 3 Compare
BNZ OKP4 This might be the one
LM A cheap way to index
LR 5,A Save for jump info
BR OKP1 Try again
OKP4 LM Next entry is the byte info
LR 5,A Save it
SR 1
SR 1
NI H'3' Remove the J bit and the direction
XS 4 Does it match?
BNZ OKP1 Try again
DCI PLMD Save data as to starting square
LR A,1 X
ST
LR A,2 Y
ST
LR A,3 BYTE
ST
LR A,4 Byte info
ST
LIS H'3'
COM
DCI BCNT Counter
ST
DCI BLNF Blink flag
LIS H'1' Set on
ST
LR A,1 Save X value
ST in XBLN
LR A,2 Save Y value
ST in YBLN
CUR2 PI CURS
DCI PLDJ STORE POSSIBLE TOUCH POINT
LR A,1
ST
LR A,2
ST
LR A,3
ST
LR A,4
ST
DCI PLMD+2 Restore initial values
LM
LR 3,A for BYTE
LM
LR 4,A and BYTE number
*Now test indicated move for legality
OKMV DCI PLMD Saved data location
LM Get the old X value
COM
INC
AS 1 This gives us the change in X
BNZ OKM01
JMP NON2 ILLEGAL
OKM01 LR 1,A Save the difference
BP OKM1
COM
INC
OKM1 LR 0,A |X|
CI H'2'
BP OKM02
JMP NON3 TOO FAR
OKM02 CLR Anticipate normal move
BNZ OKM2
LI H'10' Set Jump bit
OKM2 LR 6,A save byte info here
LM Get the old Y value
COM
INC
AS 2
LR 2,A Change in Y
BM OKM3
COM
INC
OKM3 AS 0
BNZ NON2 |X||Y|
LR A,2
NS 2
BP OKM4
LIS H'2' Backward bit
AS 6
LR 6,A
OKM4 LR A,1
NS 1
BM OKM5
LIS H'1' Left bit
AS 6
LR 6,A
OKM5 LR A,4 Get initial Byte #
SL 1 Shift it left to position
SL 1
AS 6 Add in the J and Direction bits
LR 6,A Final byte info from cursor
DCI PLMV Possible moves listing
LIS H'8' 7 moves possible
LR 0,A
OKM6 CLR
XM
BZ NONO No more entries
LR 1,A
LM
LR 5,A Save byte info
OKM7 CLR
XS 1
BZ OKM6 Last bit tested
LR 2,A We'll need it again
AI H'FF' Subtract 1
NS 1
LR 1,A Byte with bit removed
XS 2 Get extracted bit
DS 0 Count tries
NS 3 Does it check with 3
BZ OKM7 Not in table entry, try again
LR A,5 But does byte info agree?
XS 6 Compare 6 with table value
BNZ OKM7 No so count remaining bits in 1
LIS H'7' Found, so reorder count
XS 0 order from 0 thru 6
DCI BKMV
ST Save move count for book move entry
PI MWAD DO MY WAIT THEN UPDATE
PI MVC Turn off cursor
PI ENIN NOW ENABLE INTERRUPT
DCI TREE Store final values
LR H,DC
LIS H'C'
ADC
LR A,3
ST Store byte
LR A,6
ST And byte info
*Before going to SELE, we want to
*set the BLINK coordinates to
*match the "CURRENT" position
DCI XBLN DESTINATION
XDC SAVE IN DC1
DCI XOLD DCO TO XPOSITION
LM GET SAME
XDC GET DESTINATION
ST AND SET SAME
XDC SAVE NEW DESTINATION
LM GET OLD Y POSITION
XDC
ST AND RESET TO BLINK THERE
DCI BLNF DCO TO BLINK FLAG
LIS H'1'
ST SET FOR BLINK
JMP SELE
NONO LR A,5
NI H'10' A jump required?
LIS H'2'
BZ NON4
LIS H'1'
BR NON4
NON2 LIS H'2'
BR NON4
NON3 LIS H'3'
NON4 LR 0,A
DCI BCNT
LM
INC
DCI BCNT
ST
BM NON5
JMP MES0
NON5 PI WMC
JMP CUR2
DJMP DCI BCNT SET COUNTER FOR
LI H'82' LARGE NUMBER OF
ST TRIALS
DCI PLMD
XDC
DCI PLDJ
LIS H'4'
LR 0,A
DJMP1 LM GET OLD TOUCH POINT DATA
XDC
ST AND TRANSFER TO PLMD
XDC
DS 0 DECREMENT COUNT
BNZ DJMP1 DONE ENOUGH TRANSFER?
PI MWAD DO MY WAIT, THEN UPDATE
PI MVC TURN CURSOR ON
LIS H'6'
LR 0,A SET FOR "CONTINUE JUMP" MESSAGE
BR NON5 AND DISPLAY SAME
*-*-*- Message writing, uses R0, 1, SC O'24'
* calls UPDATE routine. Message # in 0.
WMC LR K,P SAVE RETURN ADDRESS
PI PUSH PUSH ONTO STACK
DCI H'872'
LI H'82'
ST TURN MESSAGE OBJECT OFF...
DCI HSAV
LR A,HU
ST
LR A,HL
ST
PI MWAD WAIT, THEN UPDATE
DCI WMCA DCO TO MESSAGE ADDRESS START
LR A,0 GET MESSAGE NUMBER
SL 1
AS 0
ADC ADD 3XNUMBER TO DCO
LISU 2
LISL 4 SET ISAR TO O'24'
LM
LR S,A SET MESSAGE LENGTH
LM
LR QU,A
LM
LR QL,A MESSAGE ADDRESS INTO Q
DCI LINE
LIS H'5'
SL 4
ST SET PROPER LINE NUMBER
DCI H'0E5F' DCO TO MESSAGE BUILD AREA
LIS H'7'
SL 4
LR 1,A SET COUNTER
CLR CLEAR ACC
WMC1 ST
DS 1
BNZ WMC1 CLEAR TEXT AREA
PI WAUD WAIT, THEN DO UPDATE
DCI H'872'
LIS H'2'
ST TURN OBJECT ON
LR DC,Q SET ADDRESS INTO DCO
PI WMS WRITE MESSAGE
PI MWAD WAIT, THEN UPDATE
DCI HSAV
LM
LR HU,A
LM
LR HL,A
PI ENIN ENABLE INTERRUPTS ONCE MORE
PI POPS POP RETURN ADDRESS
PK AND RETURN
*-*-*-*-*-*-*-*-*-*
* DATA FOR WMC
*
WMCA DC H'9' YOUR MOVE 0
DC YRMV:
DC YRMV.
DC H'9' MUST JUMP 1
DC MJM:
DC MJM.
DC H'7' ILLEGAL 2
DC MIM:
DC MIM.
DC H'7' TOO FAR 3
DC TFM:
DC TFM.
DC H'1' (null message) 4
DC MYMV:
DC MYMV.
DC H'09' TRY AGAIN 5
DC PCMM:
DC PCMM.
DC H'D' CONTINUE JUMP 6
DC CJM:
DC CJM.
DC H'5' I WIN 7
DC IWIN:
DC IWIN.
DC H'7' YOU WIN 8
DC UWIN:
DC UWIN.
YRMV DC H'0513' YOur move
DC H'0309' UR
MYMV DC H'0' - Clear message space for brow wrinkling
DC H'2913' MO
DC H'2F0B' VE
MJM DC H'2903' MUst jump
DC H'2107' ST
DC H'0' -
DC H'1703' JU
DC H'2925' MP
MIM DC H'0127' ILlegal
DC H'270B' LE
DC H'1B11' GA
DC H'27' L
TFM DC H'0713' TO far
DC H'1300' O-
DC H'1D11' FA
DC H'09' R
PCMM DC H'0709' TRY AGAIN
DC H'0500'
DC H'111B'
DC H'1101'
DC H'2B'
CJM DC H'3113' CONTINUE JUMP
DC H'2B07'
DC H'012B'
DC H'030B'
DC H'0'
DC H'1703'
DC H'2925'
IWIN DC H'0100' I WIN
DC H'0D01'
DC H'2B'
UWIN DC H'0513' YOU WIN
DC H'0300'
DC H'0D01'
DC H'2B'
*-*-*- Read keyboard
RKB LR K,P Read keyboard
PI PUSH
LISU 2
LISL 4 SET ISAR FOR DELAY TIMER
LIS H'0'
LR S,A SET FOR MAX DELAY
RKB1 PI FCS FETCH CHARACTER
BZ RKB1 NULL INPUT?
BM RKB1 NO. DEBOUNCED INPUT?
PI POPS YES. POP RETURN ADDRESS
LR A,8 GET KEYBOARD INPUT
PK AND RETURN
*-*-*- Initial moves for black
BLKM DC B'11110000' 4 pieces
DC B'00000100' Byte 1, RF
DC B'11100000' 3 pieces
DC B'00000101' Byte 1, LF
DC B'01000000' 11-15 repeat to give
DC B'00000100' a slight preference
DC H'00'
*-*-*- Generate board image
BORD LR K,P
CLR
COM
LR 3,A REG3=FF
DCI OBJ0 BRD1 START ADDRESS
LIS H'2' FLAG FOR BOR
LR 4,A SET REG 4 = 2
LIS H'6'
BRD4 LR 0,A REG0 = 6 ROWS
BRD3 LIS H'A'
LR 1,A REG 1 = 10 LINE/ROW
BRD2 LIS H'4'
LR 2,A REG2=SQ PAIRS/ROW
BRD1 LR A,3
ST STORE IN BRD
COM
ST NEXT IS COMPL. OF FIRST
DS 2
BNZ BRD1 MORE FOR THIS ROW
DS 1 NO, ALL LINE DONE
BNZ BRD2
LR A,3 DONE A TIMES YET
COM
LR 3,A
DS 0 DEC ROW COUNT
BNZ BRD3 ALL ROWS DONE?
DS 4
BZ BRD5 BOTH OBJECTS DONE?
DCI OBJ1 NO,GET BORD2 ADDRS.
LIS H'2'
BR BRD4 REG0=2
*-*-*- Now put pieces in image
BRD5 LISU 3 Pieces are here
LIS H'1' 1 for red pieces (stored first)
LR 4,A Piece, (1 Red, 0 Black, -1 King)
DCI COL0
CLR CLEAR ACC
XM IN W/STATUS
LR 0,A
LISL O'7' Decrement and shift right
BNZ MEN1 if COL0 is FF (BLACK at bottom of scree
LISL O'0' Increment and shift left
MEN1 LIS H'3' if COL0 is 0 (Black at top of screen)
LR 1,A To count bytes
MEN2 LIS H'7'
LR 2,A To count bits
DCI TAB1 Byte location table
LR A,1 This byte number
SL 1 Locations occupy 2 bytes each
ADC
LM Get the byte location
LR QU,A and save it in Q
LM
LR QL,A
LR A,0
NS 0
BNZ MEN5 Decrement and shift right if COL0 is FF
LR A,I Increment and shift left if COL0 is 0
BR MEN4
MEN3 LR A,3
SL 1 and shift left
MEN4 LR 3,A
NI H'80' (done this way for symry
BZ MEN9
BR MEN8
MEN5 LR A,D Decrement if COL0 is FF
BR MEN7
MEN6 LR A,3
SR 1 and shift right
MEN7 LR 3,A
NI H'1'
BZ MEN9
MEN8 DCI TAB2 Relative-locations-of-squares table
LR A,2 This square
ADC
LM Get square displacement
LR DC,Q Recall the location for the input byte
ADC This is the square position
LR A,4 Identify type of piece
NS 4
BM PUTK To put down a king
LIS H'4' Prepare for a piece
LR 5,A To count lines
LI H'20' Skip the rst 4 lines (4*8)
ADC
XDC
DCI BLKP Anticipate a black piece
BZ PUTL A black piece (status bit still ok)
DCI REDP No, it's a red piece
BR PUTL
PUTK LIS H'2' Only 3 lines for a crown
LR 5,A
LIS H'8' To skip 1 line
ADC
XDC
DCI KING
PUTL LM Put loop
XDC
ST
LIS H'7' To next line on screen (less increment)
ADC
XDC
DS 5
BP PUTL Loop
MEN9 DS 2
BM ME10
LR A,0
NS 0
BNZ MEN6 Shift right if COL0 is FF
BR MEN3 Shift left if COL0 is 0
ME10 DS 1
BP MEN2 Around again
LR A,4
NS 4
BM BDEX Exit from board routine
DS 4
BP MEN1 Go round again for black pieces
LISU H'4' Get set for kings
LR A,0
NS 0
LISL H'3' Decrementing case
BNZ MEN1 Dedrement and shift right if COL0 is FF
LISL H'0' Incrementing case
BR MEN1 Increment and shift left if COL0 is 0
BDEX PK
*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
* UPDATE CONTROL DATA *
*
BDAT DC H'1' FLAG SET SHORT UPDATE
DC UDIT:
DC UDIT.
DC UDIT:
DC UDIT.
* Set message length and line pointer
SEDC DCI LINE DCO TO LINE POINTER
LIS H'2'
SL 4 SET FOR SECOND LINE
ST
LR A,0
SL 4
LISL 4
LR S,A AND SET MESSAGE LENGTH
CLR CLEAR ACC
LR 1,A AND SET DEFAULT RESULT
POP AND RETURN
*-*-*- Address table for MVC*
TABL DC H'0C30'
DC H'0C80'
DC H'0CD0'
DC H'0D20'
DC H'0D70'
DC H'0DC0'
DC H'0F10'
DC H'0F60'
*-*-*- To move cursor, uses
*SC0,1,2,3,4,HU,Q,K,W, SC20-24.
CURS LR K,P
PI PUSH AND PUSH IT ON TO STACK
MAP0 PI MWAD WAIT, THEN UPDATE
LIS H'1' CAN START JOYREAD
LR HU,A SET FOR HORIZONTAL POT
PI JOYI AND READ
LR VX,A SAVE RESULT IN VX
LIS H'0'
LR HU,A SET FOR VERTICAL POT
PI JOYI
LR 0,A SAVE IN REG 0
PI AMAP CONVERT TO PROPER VELOCITY
LR VY,A SAVE RESULT
LR A,VX
LR 0,A NOW GET UNCOVERTED VX INTO R0
PI AMAP CONVERT IT
LR VX,A AND SAVE IT
PI MWAD WAIT, THEN UPDATE
PI BLNK To blink code (on)
LIS H'4'
LR 0,A
MP01 PI MWAD A second wait
DS 0
BNZ MP01
PI BLNK To blink code (off)
CLR CLEAR ACC
XS VX VX IN W/STATUS
BZ MAP7 NON-NULL X COMPONENT?
DCI XPOS YES
LM
LR X,A SET CURRENT X POSITION
LISU 2
LISL 0
CLR
LR I,A SP20<=0
LM
LR I,A SP21<=NON NULL LEAD MASK
LM
LR S,A SP22<=TRAILING MASK
CLR
XS VX VX IN W/STATUS
BM MAP3 GOING LEFT?
PI SHR SHIFT RIGHT ONE
LIS H'7' NO, GOING RIGHT.
XS X
BNZ MAP5 IN RH MOST BOX?
LISL 2 YES
XS S
BZ MAP5 TRIED TO GO TOO FAR?
MAP2 CLR YES.
LR VX,A CLEAR X VELOCITY
BR MAP7 AND CHECK Y
MAP3 PI SHL SHIFT LEFT ONE
CLR
XS X
BNZ MAP4 IN LH MOST BOX?
LISL 0 YES
XS S
BNZ MAP2 TRIED TO GO TOO FAR?
MAP4 LISL 0
CLR
XS S
BZ MAP7 IS SP20 NULL?
LISL 1 NO.
LR A,I
LR S,A
LISL 0
LR A,I
LR D,A
CLR
LR S,A SP22<=SP21,SP21<=SP20,SP20<=0,THAT ORDER
DS X AND DECREMENT X COUNT
BR MAP7 NOW GO CHECK Y
MAP5 LISL 1
CLR CLEAR ACC
XS S
BNZ MAP7 IS SP21=0?
LISL 2
LR A,D
LR I,A
CLR
LR D,A SP21<=SP22,SP22<=0, THAT ORDER
LIS H'1'
AS X
LR X,A INCREMENT X COUNT
MAP7 CLR
XS VY
BZ MAP9 VY=0?
DCI YPOS NO, SET DCO TO LAST Y POSITION
AM UPDATE Y COORD
BM MP7A Result Y is neg?
CI MAXY COMPARE W/MAX ALLOWED Y
BC MAP8 NEW Y>MAX ALLOWED VALUE?
MP7A CLR YES
LR VY,A RESET VY
BR MAP9
MAP8 LR Y,A SET NEW Y
MAP9 LR A,VY GET VY
SL 1
XS VX
BZ MP12 ANY MOVEMENT?
PI MVC YES, REMOVE OLD POSITION
CLR
XS VY
BZ MP10 ANY Y MOVEMENT?IF NOT, MUST HAVE VX NE 0
DCI YPOS
LR A,Y IS, SO RESET
ST Y POSITION
CLR
XS VX
BZ MP11 ANY X MOVEMENT?
MP10 DCI XPOS UPDATE X POSIT & MASK
LR A,X
ST
LISL 1
LR A,I
ST
LR A,S
ST
MP11 PI MVC DISPLAY NEW POSITION
MP12 CLR
OUTS 1 Clear port 1
NOP 3 NOP's for FCC
NOP Do not remove
NOP for any reason
INS 1 Get buttons
NI H'1' Strip to desired one
DCI BFLG To button flag
CLR
BNZ MP13 Any button input?
ST No, reset edge flag
MP14 JMP MAP0 And go try again
MP13 LR Q,DC Save address
XM Flag in W/STATUS
BNZ MP14 Previous input?
LIS H'1' No, reset flag
LR DC,Q Recover address
ST And reset
CON CLR
LR 0,A Set counter (Y conversion)
CON1 LR A,Y Get Y coordinate
CI YTST Compare W/test value
BC CON2 Y LE test value?
LR A,0 No, increment counter
INC
LR 0,A
LI -H'A'
AS Y
LR Y,A Y<=Y-H'A'
BR CON1 Go back and try agian
CON2 LR A,0 Get counter
LR Y,A Y now↑(0-7):(top-bottom)
AS X
NI H'1'
BZ MP14 On a legal square?
DCI COL0 Yes
CLR
XM Flag in W/STATUS
BP CON3 Machine plays RED?
LIS H'7' Yes
XS Y
LR Y,A Y<=7-Y
LIS H'7'
XS X
LR X,A X<=7-X
CON3 LR A,Y
SR 1
LR VY,A VY reg (BYTENO)<=(1/2*(7-Y)
DCI BYDT To BYTE data
LR A,X Get X coord.
ADC Add offset to base address
LM Get byte
LR VX,A Save byte into VX reg
DCI XOLD
LR A,X
ST
LR A,Y
ST SAVE CONVERTED CO-ORDINATES
PI MWAD WAIT, THEN UPDATE
PI ENIN ENABLE INTERRUPT DRIVEN UPDATE
PI POPS POP RETURN ADDRESS
PK AND RETURN
*-*-*- Data for byte values (X coord. conversions)
BYDT DC H'0880'
DC H'0440'
DC H'0220'
DC H'0110'
*-*-*- MVC Set or remove cursor
MVC LR K,P SAVE RETURN ADDRESS
DCI XPOS
LM
LR 0,A SAVE X IN R0
LISU 2
LISL 3
LM
LR I,A
LM
LR D,A LEAD IN SP23,TRAIL IN SP24
DCI YPOS
LM GET Y COORDINATE
DCI H'0C30' DCO TO OBJ0 BASE ADDRESS
ADC ADD 8 X Y COORD (W/MAX FOR Y
ADC OVER H'40', CANNOT USE "CUTE"
ADC TRICKS HERE--AND FOR SPEED,
ADC WE JUST USE STRAIGHT ADC'S).
ADC
ADC
ADC
ADC
LR A,0 GET X OFFSET
ADC AND ADD IT IN
LIS CHT
LR 0,A SET COUNT FOR TRANSFER
MVC1 LR Q,DC SAVE ADDRESS IN Q REG
LR A,QU GET HO ADDRESS
CI H'E'
BNZ MVC2 AT BOTTOM OF OBJ0
LR A,QL DEFINITELY.
CI H'F'
BC MVC2 PAST BOTTOM?
LIS H'F' YES.
LR QU,A RESET HO ADDRESS
LR DC,Q AND RESET DCO ACCORDINGLY (FOR OBJ1)
MVC2 LR A,I GET LEAD MASK BYTE
LR Q,DC SAVE DCO
XM XOR IN CURSOR
LR DC,Q RECOVER ADDRESS
ST AND RESET THAT BYTE
LR Q,DC SAVE ADDRESS AGAIN
LR A,D GET TRAILING MASK BYTE
XM XOR IN BITS
LR DC,Q RECOVER ADDRESS
ST AND RESET DATA
LIS H'6'
ADC SET TO NEXT DESTINATION
DS 0 DECREMENT COUNTER
BNZ MVC1 DONE?
PK YES, RETURN
*-*-*- AMAP Mapping joystick readings to velocities
AMAP LR A,0 GET READING
CI H'40'
BNC AMP1 VAL LE H'40'?
LI H'FF' YES.
BR AMP2
AMP1 CI H'C0'
CLR
BC AMP2 VAL GT H'C0'=D'192'
LIS H'1' YES, VELOCITY = 1
AMP2 POP RETURN
*-*-*- BLNK Blinking routine
BLNK LR K,P
DCI BLNF Test BLINK flag
CLR
XM
BZ BLN4 Need to blink?
LISU 2
LISL 3
LM Yes
LR I,A Get X value
LM
LR D,A and Y value to blink
DCI COL0
CLR
XM
BZ BLN0 Need to reverse?
LIS H'7'
XS S
LR I,A
LIS H'7'
XS S
LR D,A
BLN0 DCI H'0C30'-H'50' DC0 TO OBJ0-H'50'
LISL 4
LIS H'5'
SL 4
BLN1 ADC Add off-set
DS S
BP BLN1 Added enough?
LR Q,DC Yes
LR A,QU Get H0 address
CI H'E'
BNZ BLN2 Need reset?
LIS H'F' Yes
LR QU,A
BLN2 LR DC,Q
LISL 3
LR A,S
ADC Add off-set
LIS H'3'
LR 0,A Set counter
BLN3 LR Q,DC
LI H'C0'
XM
LR DC,Q
ST
LIS H'7'
ADC Next one to blink
DS 0 Decrement counter
BNZ BLN3 Done?
BLN4 PK
* REDM BOK2 INIT
*-*-*- Initial moves for red
REDM DC B'00000111' 3 pieces
DC B'00001010' Byte 2, RB
DC B'00001111' 4 pieces
DC B'00001011' Byte 2, LB
DC H'00'
*-*-*-*-*-*-*-*-*-*
*First replies (maximum of 4 each)
BOK2 DC H'33' 24,20 24-20 To 12-16
DC H'33' 24-20, 24-20
DC H'43' 23-19, 24-20 To 11-15
DC H'20' 22-17, 24-19
DC H'22' 22-17, 22-17 To 10-14
DC H'22' 22-17, 22-17
DC H'55' 22-18, 22-18 To 9-13
DC H'55' 22-18, 22-18
DC H'31' 24-20, 23-18 To 11-16
DC H'45' 24-19, 22-18
DC H'66' 21-17, 21-17 To 10-15
DC H'66' 21-17, 21-17
DC H'55' 22-18, 22-18 To 9-14
DC H'55' 22-18, 22-18
*-*-*-
INIT DC H'30'
DC H'10' OBJ1 L.O. RP
DC H'5F' TEXT LOW ORDER ROM
DC H'8C' OBJ0 H.O.RP+OLOR
DC H'8F' OBJ1 H.O.RP
DC H'EE'
DC H'48' OBJ0 DELTA X ---
DC H'48' OBJ1 DELTA X---
DC H'70' TEXT OBJECT DELTA X
TY0 DC H'3C' OBJ0 DELTA Y ----
DC H'14' OBJ1 DELTA Y ---
DC H'07' TEXT OBJECT DELTA Y
DC H'0D' OBJ0-X-CO
DC H'0D' OBJ1 X-CO
DC H'1C' TEXT OBJECT X COORD
DC H'48' OBJ0 Y-VALUE L.O.A
DC H'C0' OBJ1 Y-VALUE L.O.A
DC H'26' TEXT OBJECT Y VAL LO A
DC H'00' OBJ0 Y-VALUE H.0 &X-ORDER
DC H'01' OBJ1- Y-VAL H.O.$X-ORDER
DC H'82' TEXT OBJ INITIALLY OFF
UDIT DC H'30'
DC H'10'
DC H'5F'
DC H'8C'
DC H'8F'
DC H'EE'
DC H'3C'
DC H'14'
DC H'07'
TAB1 DC H'0F10' BYTE 3
DC H'0D70' BYTE 2
DC H'0CD0' BYTE 1
DC H'0C30' BYTE 0
TAB2 DC D'86' RELATIVE SQUARE POSITION TABLE
DC D'84'
DC D'82'
DC D'80'
DC D'07'
DC D'05'
DC D'03'
DC D'01'
*-*-*- YMF
YMF DC H'0513' Y0
DC H'0300' U-
DC H'2913' MO
DC H'2F0B' VE
DC H'00' -
DC H'1D' F
DC H'0109' IR
DC H'2107' ST
DC H'00' -
DC H'35' ?
DC H'00' -
DC H'00' -
DC H'00' -
DC H'00' -
DC H'0500' Y-
DC H'1309' OR
DC H'00' -
DC H'2B' N
*-*-*-*-*-*-*-*-*-*-*-*-*-
*-*-*- SKL Skill text
SKL DC H'0713' TO
DC H'00' -
DC H'2527' PL
DC H'1105' AY
DC H'00' -
DC H'00' -
DC H'00' -
DC H'00' -
DC H'00' -
DC H'0705' TY
DC H'250B' PE
ABE DC H'00' -
DC H'00' -
DC H'112D' AB
DC H'0B00' E-
DC H'00' -
DC H'00' -
DC H'00' -
DC H'00' -
DC H'00' -
DC H'00' -
DC H'00' -
DC H'11' A
DC H'00' -
DC H'00' -
BETY DC H'00' -
DC H'00' -
DC H'2D0B' BE
DC H'0707' TT
DC H'0500' Y-
DC H'00' -
DC H'00' -
DC H'00' -
DC H'00' -
DC H'00' -
DC H'2D' B
DC H'00' -
DC H'00' -
CHAS DC H'00' -
DC H'00' -
DC H'3119' CH
DC H'1109' AR
DC H'2701' LI
DC H'0B00' E-
DC H'00' -
DC H'00' -
DC H'00' -
DC H'31' C
DC H'00' -
DC H'00' -
DORT DC H'00' -
DC H'00' -
DC H'1F13' DO
DC H'0913' RO
DC H'0719' TH
DC H'0500' Y-
DC H'00' -
DC H'00' -
DC H'00' -
DC H'1F' D
DC H'00' -
DC H'00' -
*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
*MWAD*-WAIT, THEN UPDATE, AND KEEP THE*
*-*-*-*X ZOOM BIT SET PROPERLY DURING *
*-*-*-*DISPLAY MAINTENANCE.*-*-*-*-*-*-
*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
MWAD LR K,P SAVE RETURN ADDRESS
PI PUSH AND PUSH ONTO STACK
PI DAI DISABLE INTERRUPTS
PI WAIT WAIT ON APPROPRIATE LINE
DCI CMRG DCO TO PROG COPY COMREG
LI MSK MASK IN
XM TURN OFF XZOOM
DCI H'8F7' IN THE UM1 COPY
ST ONLY
PI UDAT NOW DO UPDATE
LI XZOP SET LINE FOR RESTORE XZOOM
MWD1 DCI H'8FB' DCO TO CURRENT LINE
CM COMPARE
BNZ MWD1 REACHED IT YET?
DCI CMRG YES
LM
DCI H'8F7' NOW RESET UM1 COPY
ST
PI POPS POP RETURN ADDRESS
PK AND RETURN
*-*-*- Interrupt enable for update
ENIN LI INHR:
OUTS H'C'
LI INHR.
" OUTS H'D' SET INTERRUPT VECTOR
DCI H'8F0'
LI ULIN
ST SET INTERRUPT LINE
DCI CMRG DCO TO PROG COPY COMREG
LR Q,DC SAVE ADDRESS IN Q RES
LIS H'8'
OM
LR DC,Q
ST IN PROGRAM COPY
DCI H'8F7'
ST DITTO UM1 COPY
LIS H'1'
OUTS H'E' ENABLE SMI...
EI ENABLE CPU
LR J,W SAVE SAME STATUS
POP AND RETURN
*-*-*- Interrupt disable
DAI DI DISABLE CPU INTERRUPT
LR J,W SET J ACCORDINGLY
DCI CMRG DCO TO PROG COPY COMREG
LR Q,DC SAVE ADDRESS
LIS H'8'
COM
NM TURN OFF BIT
LR DC,Q IN THE
ST PROGRAM COPY,
DCI H'8F7'
ST AND THE UM1 COPY
CLR
OUTS H'E' NOW DISABLE SMI
POP AND RETURN
*-*-*-* SCRD SCRATCHPAD TO RAM DIRECT
*
SCRD LR K,P SAVE RETURN ADDRESS
LISU PLOC
LISL 0
SCD1 LR A,I
ST
BR7 SCD1
LR A,I
ST
LISU KLOC
SCD2 LR A,I
ST
BR7 SCD2
LR A,I
ST
PK DONE, SO RETURN
*-*-INHR Interrupt handler, saves and restores data
INHR LR 8,A SAVE ACC
LR A,IS
LISU 6
LISL 0
LR I,A SAVE ISAR IN REG O'60'
LR A,HU
LR I,A SAVE HU IN REG O'61'
LR A,HL
LR I,A SAVE HL IN REG O'62'
LR A,J
LR I,A SAVE J REG IN REG O'63'
LR H,DC SAVE OLD DCO
DCI RGSV DCO TO SAVE AREA START
LR A,HU
ST
LR A,HL
ST SAVE OLD DCO IN RGSV,RGSV+1
XDC
LR H,DC
XDC
LR A,HU
ST
LR A,HL
ST SAVE OLD DC1 IN RGSV+2,RGSV+3
LR A,KU
ST
LR A,KL
ST SAVE K REG IN RGSV+4,RGSV+5
LR K,P PC1 INTO K REGISTER
LR A,KU
ST
LR A,KL
ST PC1 INTO RGSV+6,RGSV+7
LR J,W SAVE OLD STATUS
LISU 2
LISL 3
INH2 LR A,D
ST SP23,22,21,20 IN, RESP.
BR7 INH2 RGSV+8,+9,+A,+B
DCI CMRG DCO TO COMMAND REGISTER
LI MSK MASK ON
XM TURN OFF X ZOOM BIT
DCI H'8F7' IN THE UM1
ST COMMAND REGISTER
PI UDAT UPDATE UM1 DISPLAY REGISTERS
LI XZOP SET LINE FOR XZOOM ON
INH1 DCI H'8FB' DCO TO CURRENT Y LO
CM COMPARE
BNZ INH1 DIFFERENT?
DCI CMRG NO. RESTORE X ZOOM
LM FROM OLD COPY
DCI H'8F7' TO THE UM1 COPY
ST
*
* RESTORE ALL REGISTERS
*
DCI RGSV DCO TO SAVE AREA
LM
LR HU,A
LM
LR HL,A OLD DCO TO H REG
XDC
LR DC,H NOW INTO DCO
XDC AND INTO DC1
LM
LR HU,A
LM
LR HL,A OLD DC1 INTO H REGISTER
LIS H'2'
ADC BYPASS K FOR A MOMENT
LM
LR KU,A
LM
LR KL,A
LR P,K RESTORE PC1
LISU 2
LISL 3
INH3 LM RESTORE SP20-23 FROM
LR D,A RGSV+8,+9,+A,+B
BR7 INH3
DCI RGSV+4
LM
LR KU,A
LM
LR KL,A RESTORE K REGISTER
LR DC,H RESTORE DC1
XDC AND SET DCO&DC1 PROPERLY
LR W,J NOW RESTORE STATUS AT ENTRY
*
* NOW RESTORE J,H,A FROM SCRATCH PAD
*
LISU 6
LISL 3
LR A,D GET J
LR J,A
LR A,D GET HL
LR HL,A
LR A,D
LR HU,A RESTORE HU
LR A,D GET ISAR
LR IS,A RESTORE ISAR
LR A,8 RESTORE A
EI INT. ENABLE
POP
*-*-*-
WAST LR K,P Delay loop to WASTE some time
WAS2 LIS H'F'
LR 1,A
WAS3 CLR
LR 2,A
WAS4 DS 2
BNZ WAS4
DS 1
BNZ WAS3
PK
*
IWN PI BORD
LIS H'7' "I win" message
BR STO2
UWN LIS H'1' Get board reversed
SL 4 for player's move
LR HL,A orientation
LR DC,H
PI SCRA
LR DC,H
PI RASC
LR A,7
COM
LR 7,A
PI BORD Now show board
LIS H'8' "You win" message
STO2 LR 0,A
PI WMC Write message
PI MWAD Wait then update
PI ENIN Enable interrupts
LI H'40'
LR 3,A
STO3 PI WAST Leave message up awhile
DS 3
BNZ STO3
STO4 PI MWAD Do wait, then update
DCI H'872'
LI H'82'
ST TURN MESSAGE OFF
LR A,0 Get message type
LR 6,A And save in REG 6
ZS0 LIS H'D'
LR 1,A Set NOTE COUNT (14 NOTES)
ZS1 LIS H'7' Set mask
XS 6
DCI TUN2 Default tune--for Player win
BNZ ZS2 Computer wins?
DCI TUN1 Yes, set tune accordingly
ZS2 LR A,1 Get current NOTE COUNT
SL 1
AS 1 Mult by three for proper offset
ADC And add it in
LISU 4
LISL 4
LM Get DELTA LINE count
LR D,A Into SP44
LM
LR S,A Get LEVEL into SP43
LM And get DURATION into
LR 5,A REG 5
PI SNE Enable sound
ZS3 PI WAUD And wait
DS 5 Decrement DURATION
BNZ ZS3 Done with NOTE?
DS 1 Yes, decrement NOTE COUNT
BP ZS1 Done all of SONG?
LI H'A0' YES
LR 1,A Set counter
ZS4 PI MWAD Delay
DS 1 For approximately
BNZ ZS4 2.7 Seconds
JMP H'4000' And return to RESIDENT
FLSH DCI SELX DCO TO MOVE NUMBER
LIS H'2'
CM
BC FLS5 PAST BOOK MOVES?
PI BORD NO, JUST DISPLAY BOARD
FLS6 JMP PMOV AND GO PLAYERS MOVE
FLS5 PI MWAD WAIT, THEN UPDATE
DCI H'872' DISABLING INT. AT SAME TIME
LI H'82'
ST TURN OFF MESSAGE OBJECT
LISU 4
LISL 4
LI H'30'
LR D,A SET DELTA LINE
LIS H'3'
LR S,A SET LEVEL
PI SNE ENABLE SOUND
LIS H'F'
LR 6,A SET DURATION
FLS1 PI WAUD WAIT, THEN UPDATE
DS 6
BNZ FLS1 BEEPED LONG ENOUGH?
PI DAI YES, DISABLE SOUND
LIS H'5'
LR 6,A SET BLINK COUNT
FLS2 DCI TRE2
PI RASC GET BOARD AFTER PLAYER MOVE
DCI H'0E30' DCO TO TEMP AREA
LR Q,DC SAVE ADDRESS
PI SCRA SCRATCH TO RAM, REVERSED
LR DC,Q RECOVER ADDRESS
PI RASC AND INTO SCRATCHPAD
PI WAUD NOW DO UPDATE
PI ENIN
PI BORD DISPLAY BOARD
LI H'20'
LR 3,A SET COUNTER
FLS3 PI MWAD WAIT A BIT
DS 3
BNZ FLS3
DCI TREE
PI RASC BOARD AFTER MACHINE MOVE
PI ENIN
PI BORD DISPLAYED
LI H'20'
LR 3,A
FLS4 PI MWAD WAIT A MOMENT
DS 3
BNZ FLS4
DS 6
BNZ FLS2 DONE ENOUGH TIMES?
BR FLS6 YES,GOTO PLAYER MOVE
ORG H'1800' SELE
SELE LISU PLOC
LISL 0
LR DC,H
LIS H'C' To get MOVE byte
ADC
LM
LR 0,A Save it temporarily
NS 0 To set status byte
BNZ SEL3
JMP NEXT To get next MOVE byte
SEL3 CLR
COM -1 in A
ADC Get back to move byte
AS 0
NS 0 Remove right-most on-bit
ST Put remaining bits back (and index)
XS 0 This gets the extracted bit
LR 6,A Save it in 6
LM Now get the byte designation
SEL4 LR 5,A
SR 1
SR 1
NI H'3' Separate the byte indicator part
LR 4,A Save it in 4
LR A,5
NI H'13' Separate the JUMP bit and the direction
LR 5,A Save them in 5
DELE LI ISA Process Active and Kings for source dele
AS 4 Add byte #
LR IS,A Get to initial byte
LR A,S
LR 3,A
XS 6 Delete moving piece
LR S,A from byte
LISU KLOC To get to corresponding KING byte
LR A,S
NS 6 Was the piece a king?
BZ DEL2
XS S If it was delete king bit
LR S,A
LIS H'7' Non-zero in 2 for king
DEL2 LR 2,A 0 for man, 7 for king, (later 1 for prom
LISU PLOC Back to active section
*Now locate captured piece if jump or find destination in normal move
LR A,6 Recall MOVE bit
SR 4
BZ INRH Bit was in right half of byte
INLH LR 3,A Save partially shifted MOVE bit
LIS H'1' Get direction
NS 5 To test right-most bit
BZ INL2 RF or LB move where 4 shift is correct
LR A,3
SR 1 LF and LB require an additional shift
LR 3,A
INL2 LIS H'2' Now test for fore or aft
NS 5
BZ BOTH Forward move, no byte shift needed
LR A,D Only to decrement ISAR
INL3 BR BOTH
*
INRH LR A,6 Get MOVE bit again
SL 4 Left shift if in right half
LR 3,A Save partially shifted MOVE bit
LIS H'1'
NS 5 Get direction
BNZ INR2 LF or LB where 4 shift is correct
LR A,3
SL 1 RF and RB require an additional shift
LR 3,A
INR2 LIS H'2' Now test fore and aft
NS 5
BNZ BOTH
LR A,I Only to increment ISAR
BOTH LR A,5 Now is this a jump or a normal move?
*ISAR still points to active region but may designate
*an empty square or the capture square
SR 4 Set status for jump bit
BNZ JUMP
JMP NORM It's a normal move
JUMP LR A,IS
AI H'4' To get to passive pieces
LR IS,A
LR A,S
XS 3 Remove captured piece
LR S,A
LR A,IS
AI H'4' Corresponding king location
LR IS,A
LR A,S Get byte
NS 3 Is the piece a king?
BZ JUM1 No
XS S Yes, Remove it
LR S,A
LIS H'2'
COM Fast -3
BR JU11
JUM1 LIS H'1'
COM Fast -2
JU11 LR 0,A
LI PASM
LR IS,A
LR A,S
AS 0
LR S,A
JU12 LI ISA Back to moved-from location
AS 4 Byte number is in 4
LR IS,A
LIS H'2'
NS 5 Test for fore or aft
BZ JUMA Fore move
LR A,D Decrement ISAR (destination always in ne
BR JUMB
JUMA LR A,I Increment ISAR
JUMB LR A,IS Get the destination byte off-set
AI H'E8' by subtracting O'30' from ISAR value
LR 4,A needed if there is a continuation
LIS H'1' Get direction
NS 5 Test for right or left
LR A,6 Get original pieceocation
BZ JUM2 0 for R move, ≠0 for L move
SR 1 Left moves involve a right shift of 1
BR JUM3
JUM2 SL 1 Right moves involve a left shift of 1
JUM3 LR 3,A Save bit byte in 3, freeing 6 for other
LR 1,A As mask in FIND for continuation
LR A,S
XS 3 Set piece down
LR S,A
CLR
AS 2 Was the piece a king?
BZ JUMC No, might be a promotion
CLR
LR 0,A Temporary record of promotion credit
BR JUM6 Already a king so no promotion
JUMC LIS H'2'
NS 5 Which side is active
LR A,IS
BZ JUM4 0 if forward
CI O'30' Is this byte 0?
BNZ JU71 No, so no promotion
LIS H'F' and t king row?
SL 4
BR JUM5 Promotion indicated, no double jump
JUM4 CI O'33' Is this byte 3?
BNZ JU71 No, so no promotion
LIS H'F' and the king row?
JUM5 NS 3
BZ JU71 No
LIS H'1' 1 for promotion
LR 2,A It was 0
LR 0,A Credit for promotion
LR 6,A Used in FIND for no continuation
JUM6 LISU KLOC Get to King position
LR A,S
AS 3 Put down a king
LR S,A
CLR
XS 0 Was there a promotion?
BZ JU71 No
LISU 4 Yes
LISL 6
LR A,S
INC Add for promotion
LR S,A
BR JUM9 No continuation if promotion
JUM7 CLR
XS 0 Should we check for a double jump?
BZ JU71 Yes, a 0 means no promotion
JUM9 JMP FORE
* Set up conditions to try to find a continuation
JU71 LR A,HL
SR 4
CI H'C' Is there room?
BM JUM9 No
CI H'1' Is this a player's board?
BNZ JU78 No
DCI PLMV Yes, restart PLMV
CLR
ST
BR JU77 and keep to this level
JU78 DCI MOBS GET MOVE COUNT
AI -H'2'
ADC
LM
LR 2,A
CLR MOBILITY FOR PASSED BOARD
ST TO ZERO TO PREVENT COMPRESS
LR DC,H
LI H'1C' Get to byte location
ADC in the "passed board" position
LR A,3 Save destination info
ST the move byte
LR A,4
ST and the byte #
CLR
COM and a flag of -1
ST in the ACTM position
LR A,2 and # of moves in PASM
ST
DCI SCOR-6 Advance score (passed board as well)
LR A,HL
SR 4
SL 1
ADC
JU73 LR Q,DC
XDC
LR DC,Q
LIS H'4'
ADC
LIS H'2'
LR 0,A
JU74 XDC
LM
XDC
ST
XDC
CI H'C1'
LM
XDC
BNZ JU75
INC
JU75 ST
DS 0
BNZ JU74
LIS H'2' Copy data two blocks forward
SL 4
AS HL
LR HL,A
JU77 LR DC,H
PI SCRD SC to RA direct
PI EMPT Re-do to reflect changes
LR A,3 Save destination
LR 1,A as mask for FIND
CLR
LR 2,A
LR 6,A
JMP RFJ Find continuations if any
* NORM FORE
*Now make normal move
NORM LR DC,H Back in step
CLR
LR 0,A Flag for no promotion
LISU PLOC Get back to Active pieces
LR A,S LISL still OK
AS 3
LR S,A Put in moved piece
LR A,2 Was it a kin
NS 2
BNZ NOM6 Yes so don't promote but do put king dow
LIS H'2'
NS 5 Test for direction
LR A,IS
BZ NOM4 Is it going forward?
CI O'30' Did it get to the byte 0?
BNZ FORE No
LIS H'F' and in king row?
SL 4
BR NOM5 Mark for promotion
NOM4 CI O'33' Did it get to byte 3?
BNZ FORE No
LIS H'F' and in king row?
NOM5 NS 3
BZ FORE No
LIS H'1'
LR 0,A A promotion flag
NOM6 LISU KLOC Now get to king byte
LR A,S Get corresponding king byte for destinat
AS 3 Insert king
LR S,A And replace byte
CLR
AS 0
BZ FORE
LI ACTM Get to active material location
LR IS,A
LR A,S
INC Credit for promotion
LR S,A
FORE LR A,HL Where are we?
SR 4
CI H'1'
BNZ FOR8
JMP FOR5 Player's move has been made
FOR8 LR A,7
COM Change color
LR 7,A
LIS H'1'
SL 4
AS HL
LR HL,A
LR DC,H GET back in step
PI SCRA Prepare for normal advance
LR A,HL Can we advance score?
SR 4
CI H'3' Note HL has already be advanced
BM FOR2 Advance score normally
BNZ FOR4 Special case
DCI SCOR+2
LI H'C1'
ST
INC
ST
BR FOR4 May still be a special case
FOR2 SL 1 Scores take 2 bytes each so *2
DCI SCOR-4
ADC Current location
LR Q,DC
XDC
LR DC,Q
LIS H'3'
COM Fast -H'4'
ADC Get to earlier entry
LM Copy it
XDC
ST
XDC
CI H'C1'
LM
XDC
BNZ FOR7
INC
FOR7 ST
* Compacting routine to save RAM space.
*TEMPORARILY REMOVED TO SAVE ROM SPACE
FOR3 JMP FIND Go forward normally
FOR4 DCI SELX
LR Q,DC
LM
CI H'1'
BM FOR3 Normal play
INC Book or random move has been made
LR DC,Q
ST so count thias a move
CLR Clear start of PLMV list for
DCI PLMV listing player's possible moves
ST
LR DC,H
XDC
DCI TREE Prepare for TRAN
LR H,DC
LIS H'1'
SL 4
LISU 2
LISL 0
LR S,A
PI TRAN
JMP FIND FIND exits to PMOV when HL is H'10'
FOR5 PI BORD Show board after players move
LIS H'4' "MY MOVE"
LR 0,A
PI WMC
DCI SCOR Start scores off at H'C100'
LI H'C1' so that CM's will always work
ST
ST
ST
INC
ST
LR A,7
COM Change color
LR 7,A
DCI TRE2 Set for machine's first move
LR H,DC
PI SCRA SC to RA with sides reversed
LR DC,H
PI RASC RA to SC preparing for a normal move
DCI SELX
LR Q,DC
LM
INC Add 1 to move count
LR DC,Q
ST
CI H'1'
BZ FOR6 Use stored move
JMP FIND Go find normal reply
FOR6 LISU 2 Get random number
LISL 5
LIS H'3'
NS S 0 to 3 random number
LR 0,A
SR 1
LR 1,A 0 to 1 random number
LIS H'1'
NS 0
LR 0,A 2nd 0 to 1 random number
* Machine to make 2nd move from book
DCI BKMV Get stored move munber
LM
SL 1 X2, 2 entries for each input move
AS 0 Random choice between them
DCI BOK2 Stored table of book replies
ADC
LM Get reply number
LR 0,A
CLR Use second number to select which half
XS 1
LR A,0
BZ BMV2
SR 4
BMV2 NI H'7'
LR 0,A The final selection
DCI REDM Possible Red moves
BM17 LM Get byte record
LR 1,A
BM18 LR A,1
NS 1
BNZ BM19 Is this byte exhausted?
LM Step over byte info
BR BM17 Go to next byte record
BM19 LR 2,A
AI H'FF' Subtract 1
NS 1
LR 1,A byte less rightmost bit
XS 2 This leaves 1 bit in A
DS 0
BP BM18
LR 6,A Save the byte bit
LM Get the byte info
LR 4,A The byte indicator
LR DC,H
LIS H'C'
ADC
LR A,6
ST
LR A,4
ST
JMP SELE
* RASC SCRA FKT STMV
*-*-*- RASC RAM to SC transfer
RASC LR K,P RAM to SC
LISU PLOC ←SC buffer with Active and Passive
LISL 0
RAS2 LM
LR I,A
BR7 RAS2
LM
LR I,A
LISU KLOC
RAS3 LM
LR I,A
BR7 RAS3
LM
LR I,A
PK
* SCRA SC to RAM with side reversal
SCRA LR K,P SC to RAM for side reversal
LISU PLOC
LISL 4
LIS H'8'
LR 0,A
SCR1 LR A,I
ST
DS 0
BNZ SCR1
LISU KLOC
LISL 0
LIS H'4'
LR 0,A
SCR2 LR A,I
ST
DS 0
BNZ SCR2
CLR
ST
ST
LISL 7
LR A,D
ST
LR A,D
ST
PK
*-*-*- Test if Kings only can move
FKT LR K,P
CLR
AS 7
BNZ FK1 Only kings in this direction
FKT2 CLR
XS 3
PK Normal pieces OK
BKT LR K,P
CLR
AS 7 Test sides for backward move
BNZ FKT2 NORMAL pieces can move
FK1 LIS H'2'
SL 4
AS 4
LR IS,A KINGS only can move
LR A,S
NS 3
LR 3,A
PK
*Subroutine to add to MOBILITY, and to store MOVE and FLAG bytes if nece
STMV LR K,P
LR A,HL
SR 4
CI H'01' Is this the player's board
BNZ STM3 No
DCI PLMV Player's moves stored separately
STM0 CLR
XM
BZ STM1 Find empty space
LM Skip info space
BR STM0 Try again
STM1 CLR Back up
COM
ADC
LR A,3
ST
LR A,4
SL 1
SL 1
AS 5
ST
CLR
ST Store 0 as stop
BR STM2
STM3 CLR
XS 2 To set status byte
BNZ STM2 One is already stored
LR DC,H Get back in step
LIS H'C' To get to MOVE byte
ADC
STM4 LR A,3 Get move byte
ST Store it in RAM
LR A,4 Get the byte pointer
SL 1
SL 1
AS 5
ST Put this into RAM
LR DC,H May be necessary
STM2 CLR
LR 0,A To accumulate count
LR A,3
STM5 DS 0
AI H'FF'
NS 3 Removes rightmost bit
LR 3,A
BNZ STM5
LR A,0
COM
INC
AS 2 Add in previous count
LR 2,A
PK
* NEXT FIND RFJ LFJ RBJ LBJ
NEXT PI EMPT Needs redoing if came to SELE via AFT
LR DC,H
LR A,HL
SR 4
CI H'3'
BP NEXX Can not be a continuation
LIS H'3' Look to earlier board data
COM Fast -4
ADC
LM
LR 1,A Get move byte just in case
LM
LR 4,A and byte info
CLR
LR 2,A
XM Now look at ACTM
BP NEXX Not a continuation board
LR DC,H
LIS H'D'
ADC
LIS H'3' Get last used direction
NM
INC
CI H'3'
BM NEXY Last direction used
LR 5,A
CLR
LR 2,A Set move count to zero
COM
LR 6,A Set continuation flag
JMP RBJ0
NEXX LR DC,H
LIS H'D' Last used byte info
ADC
LM
LR 5,A
NI H'F'
INC
LR 0,A
CI H'F' Is this the last byte and direction?
BP NEXA
NEXY JMP AFT Yes, so back up
NEXA LR DC,H
LIS H'1' Set to 1 for normal back-up
LR 6,A
CLR
LR 2,A Reset move count
COM
LR 1,A All pieces allowed to move
LR DC,H
LR A,0
SR 1
SR 1
NI H'3'
LR 4,A
LR A,5
CI H'F'
LIS H'3'
BM NEXJ Jumps required
NS 0
LR 5,A
BZ NEN0
JMP RBN0
NEN0 JMP RFN
NEXJ NS 0
LR 5,A
BZ NEJ0
JMP RBJ0
NEJ0 JMP RFJ
*We enter here on going forward
FIND LR DC,H
LR A,HL
SR 4
CI H'2'
BNZ FIN1
LIS H'E' Compute ACTM+PASM+9
ADC
LIS H'B' Constant term
AM
AM
DCI AP20 Used by EVAL to compute MAT
ST
LR DC,H
FIN1 PI RASC Get board into SC
PI EMPT Compute the empty squares
CLR
LR 4,A Start with byte 0
LR 2,A Mobility count and move-found flag
LR 6,A So all moves will be found
COM
LR 1,A To find all possible jump moves
RFJ LI ISA Active pieces
AS 4 Add byte off-set
LR IS,A Get to byt←
LR A,S
NS 1 FF if normal, 1 bit only for continuatio
LR 3,A 3 used to develop final byte
PI FKT Any forward moving pieces?
BZ RBJ No, look to backward moving
LI ISE+1 Look to empty squares forward
AS 4 Add byte off-set
LR IS,A Dtination byte location
LR A,S
SR 1
NS 3
LR 3,A Only pieces that have place to land
LI ISP Passive pieces
AS 4
LR IS,A
LR A,I Look to RF passive pieces forward
SL 4 In front of ft-most bits
LR 0,A
LR A,S
SR 4 In front of right-most bits
SR 1
AS 0
NS 3
LR 3,A Pieces that can jump RF
BZ LFJ None was found
LIS H'1' The RFJ direction and J indicator
SL 4
LR 5,A
PI STMV Store move byte and info
CLR
AS 6 Recall indicator
BNZ LFJ2
LFJ LI ISA
AS 4 Add byte off-set
LR IS,A Get to initial byte
LR A,S
NS 1 FF if normal, 1 bit only for continuatio
LR 3,A
PI FKT
LI ISE+1 Empty squares forward
AS 4
LR IS,A
LR A,S
SL 1
NS 3
LR 3,A Only pieces that have a place to land
LI ISP
AS 4
LR IS,A
LR A,I
SL 4
SL 1
LR 0,A
LR A,S
SR 4
AS 0
NS 3
LR 3,A Pieces that can jump LF
BZ RBJ
LI H'11' The LFJ direction and J indicator
LR 5,A
PI STMV
CLR
XS 6
BZ RBJ
LFJ2 BR RBJ2
RBJ0 LR A,5
CI H'2' Which direction, 1, 2, or 3?
BM LBJ It was a 3
BNZ LFJ It was a 1
RBJ LI ISA
AS 4 Add byte off-set
LR IS,A Get to initial byte
LR A,S
NS 1 FF if normal, 1 bit only for continuatio
LR 3,A
PI BKT Any backward moving pieces?
BZ FJ1 No
LI ISE-1 Look to empty squares backward
AS 4
LR IS,A
LR A,S
SR 1
NS 3
LR 3,A
LI ISP-1 Look to passive pieces backward
AS 4
LR IS,A
LR A,I
SL 4
LR 0,A
LR A,S
SR 4
SR 1
AS 0
NS 3
LR 3,A Pieces that can jump RB
BZ LBJ
LI H'12' The RBJ direction and J indicator
LR 5,A
PI STMV
CLR
XS 6
RBJ2 BNZ LBJ2
LBJ LI ISA
AS 4 Add byte off-set
LR IS,A Get to initial byte
LR A,S
NS 1 FF if normal, 1 bit only for continuatio
LR 3,A
PI BKT
LI ISE-1 Empty squares backward
AS 4
LR IS,A
LR A,S
SL 1
NS 3
LR 3,A
LI ISP-1 Look to passive pieces backward
AS 4
LR IS,A
LR A,I
SL 4
SL 1
LR 0,A
LR A,S
SR 4
AS 0
NS 3
LR 3,A Pieces that can jump LB
BZ FJ1
LI H'13' The RBJ direction and J indicator
LR 5,A
PI STMV
CLR
XS 6
BZ FJ2 We want them all
LBJ2 JMP SELE A successful NEXT
FJ1 CLR No backward moves
XS 6
BZ FJ2 We want them all
BP FJ3 Try next byte
JMP AFT A NEXT continuation failure
FJ2 LR A,1 Was it a first continuation try?
CI H'FF'
BNZ FJ4 Yes
FJ3 LR A,4 No, to next board byte
INC
NI H'3'
LR 4,A
BZ FJ9 There are no more
JMP RFJ Go round again for next byte
FJ4 CLR A first continuation try
XS 2 Was it successful?
BZ FJ5 No
* Successful continuation try
LR A,HL
SR 4
CI H'5' Where are we?
BM FJ7 Could be a second continuation
CI H'1' A player's board
BNZ FJ10 No
PI BORD Show board
JMP DJMP
* Unsuccessful continuation try
FJ5 LR A,HL
SR 4
CI H'1' A player's board
BM FJ6 No
JMP FOR5 "MY MOVE" etc
FJ6 LIS H'1' Back 2 levels
COM
SL 4
AS HL
LR HL,A
CI H'20' Machine's first move?
BNZ FJ6A No
DCI MOBS
LIS H'1'
XM How many moves?
BNZ FJ6A More than 1 possible jump
DCI TREE
PI SCRA Save board as move
JMP AFTT Find player's possible moves, etc
FJ6A JMP FORE
* Successful continuation that might be compacted
FJ7 DCI TRE3 Was H'30' passed
CLR
XM
BM FJ10 Yes, not safe to compress
DCI TRE4 Was H'40' passed?
CLR
XM
BM FJ10 Yes, not safe to compress
LR DC,H
LI H'FF'
ADC
LM
CI H'1' Was there but 1 jump earlier?
BNZ FJ10 No, so can't compress
LR DC,H Yes, so we can move data
XDC back by 2 levels
LIS H'1' and so save space
COM A fast -2
SL 4
AS HL
LR HL,A
LR DC,H
LISU 2
LISL 0
LIS H'1'
SL 4
LR S,A
PI TRAN
FJ8 LR A,HL
SR 4
BR FJ11
* All bytes exhausted
FJ9 CLR
XS 2
BNZ FJ10 Jumps found
CLR
XS 6 Go to normal moves?
BZ RFN Yes
JMP AFT No more jumps
FJ10 LR A,HL
SR 4
CI H'C'
BM FJ12 Too bad, out of space
CI H'1'
BNZ FJ11 Not player's FIND
JMP FLSH FLASH MOVE
FJ11 AI -H'2'
DCI MOBS
ADC
LR A,2
ST
LR DC,H Prepare for continuation
LI H'1E' To ACTM in passed board
ADC These data are over-
CLR written if no continuation
COM A -1 signals
ST a continuation
LR A,2 A 1 here signals
ST a single jump case
JMP SELE
FJ12 LISU KLOC Correct PASM and stop
LISL H'7'
LIS H'1' Allow for a piece capture
COM A fast -2
AS S
LR S,A
JMP EVAL
RFN LI ISA
AS 4 Add byte off-set
LR IS,A Get to initial byte
LR A,S
LR 3,A
PI FKT
BZ RBN
LI ISE Start of empty region
AS 4 Add off-set
LR IS,A
LR A,I Look to RF empty squares
SL 4
LR 0,A
LR A,S
SR 4
SR 1
AS 0
NS 3
LR 3,A Pieces that can move RF
BZ LFN
CLR
LR 5,A
PI STMV
CLR
XS 6
BZ LFN
JMP SELE
LFN LI ISA
AS 4 Add byte off-set
LR IS,A Get to initial byte
LR A,S
LR 3,A
PI FKT
BZ RBN
LI ISE Start of empty region
AS 4 Add off-set
LR IS,A
LR A,I Look to LF empty squares
SL 4
SL 1
LR 0,A
LR A,S
SR 4
AS 0
NS 3
LR 3,A Pieces that can move LF
BZ RBN
LIS H'1'
LR 5,A
PI STMV
CLR
XS 6
BZ RBN
JMP SELE
RBN0 LR A,5
CI H'2' Which direction 1, 2 or 3?
BM LBN It was a 3
BNZ LFN It was a 1
RBN LI ISA
AS 4 Add byte off-set
LR IS,A Get to initial byte
LR A,S
LR 3,A
PI BKT
BZ NORT
LI ISE-1
AS 4 Add off-set
LR IS,A
LR A,I Look to RB empty squares
SL 4
LR 0,A
LR A,S
SR 4
SR 1
AS 0
NS 3
LR 3,A Pieces that can move RB
BZ LBN None can
LIS H'2'
LR 5,A
PI STMV
CLR
XS 6
BNZ NORF
LBN LI ISA
AS 4 Add byte off-set
LR IS,A Get to initial byte
LR A,S
LR 3,A
PI BKT
BZ NORT
LI ISE-1
AS 4 Add off-set
LR IS,A
LR A,I Look to LB empty squares
SL 4
SL 1
LR 0,A
LR A,S
SR 4
AS 0
NS 3
LR 3,A Pieces that can move LB
BZ NORT
LIS H'3'
LR 5,A
PI STMV
CLR
XS 6
BZ NORT
NORF JMP SELE
*We get here if we want to compute mobility and also if no moves found
NORT LR A,4
INC
NI H'3'
LR 4,A
BZ NOR0
JMP RFN Go round again for next byte
NOR0 CLR
XS 2 Get mobility count
BNZ NOR1
CLR
XS 6
BNZ AFT Not an original FIND
LR A,HL
SR 4
CI H'2'
BM AFT0 Not yet a sure win or lose
BZ NOR9
JMP IWN I win situation
NOR9 JMP UWN Player's win
NOR1 LR A,HL Where are we?
SR 4 Get Ply number
CI H'1'
BNZ NOR2 Checking for possible player's moves?
JMP FLSH FLASH MOVE
NOR2 CI H'D' Are we out of space?
BM NOR4 Yes
AI -H'2' To index MOBS
LR 0,A
DCI PLY0 Neg. of allowed MOB sum
LM
DCI MOBS
BR NOR5
NOR3 AM Add up mobilities
NOP Space for INC if needed
NOR5 DS 0
BP NOR3
AS 2 Add in the current one
BM NOR7 Not time to stop
LR A,HL
CI H'30' Don't stop at 30 ever
BNZ NOR4 Time to stop
NOR7 LR A,2
ST Save latest mobility
NOR6 JMP SELE and go on
NOR4 JMP EVAL
* AFT
*MAT EQU H'0' Register used for Material Adv. term
*POT EQU H'6' Register used for Positional Adv. term
*Defined earlier
*HLS EQU H'4' Register to save HL off-set
*No more moves found so time to back up
AFT LR A,HL Prepare to back up
SR 4
CI H'2'
BNZ AFT0 Not at end of tree search
*Prepare for verification of player's reply
AFTT DCI TREE
LR H,DC BACK TO PLAYER'S BOARD
LR A,7
COM Reverse sides
LR 7,A
DCI PLMV This spe is also used by TREE routine
CLR Clear first byte
ST
JMP FIND Get verification info for move
AFT0 SL 1 2 bytes per entry
DCI SCOR-4
ADC
LR Q,DC
LM
LR MAT,A The current material advantage term
LM
LR POT,A The current positional term
AFTE LR A,HL
CI H'30'
BNZ AFT1 Must test for double jump and continuati
DCI SCOR
LR Q,DC
LIS H'1'
LR 1,A So board can be saved if indicated
JMP AP2X Can handle with -2 passed case
AFT1 LR DC,H EVAL enters here
LIS H'1' Neg. ACTM for passed board
COM Fast -2
ADC
CLR
XM Is -1 board passed
BM AFP1 Yes
LI H'EF' Is -2 board passed
ADC
CLR
XM
BM AFP2 Yes
* -1 and -2 boards not passed
LR A,HL
SR 4
AI -H'2'
LR 1,A Back 2 from current HL
SL 1
DCI SCOR-4
ADC
LR Q,DC
BR AP2Y General routine can now handle
* -1 board is passed so this was a multiple jump
AFP1 PI AFBX
LIS H'1'
AS 1
LR 1,A
LIS H'2'
ADC
LR Q,DC
LR A,MAT
CM
BM AP12 Back score for sure
BNZ AP13 Do not back score
LR A,POT
CM
BP AP13 Do not back
AP12 LR DC,Q Back score here
LR A,MAT
ST
LR A,POT
ST
AP13 JMP AF2B Back H by 2
* -2 board is passed so backing into a continuation
AFP2 PI AFBX
LR A,1
CI H'1'
BZ AP22 Can't prune may need to save board
* Handles both normal and backing into continuation cases
AP2Y LR A,MAT
CM
BM AP22 Can't prune
BNZ AP21 Can prune
LR A,POT
CM
BM AP22 Can't prune
AP21 LR A,1 Prune around multiple jump
SL 4
LR HL,A
JMP ABBB Prepare for SELE
AP22 LIS H'2' Forward 1 level
LR DC,Q
ADC
LR Q,DC We may need to save score
AP2X LR A,POT
COM
INC
LR POT,A
LR A,MAT
COM
INC
LR MAT,A
CM
BM AP23 Can back score
BNZ AF1B Can't back score
LR A,POT
CM
BP AF1B Can't back score
AP23 LR DC,Q Back score
LR A,MAT
ST
LR A,POT
ST
LR A,1 Should the board be saved?
CI H'1' Was 30 passed?
BNZ AF1B No, back 1 level in HL
LR DC,H Yes
XDC
DCI TREE
LISU 2
LISL 0
LIS H'1'
SL 4 Fast H'10'
LR S,A
PI TRAN Save board
BR AF1B and back 1 level
* Final backing up
AF2B LIS H'E' Back 2 levels
SL 4 Fast H'E0'
BR AFBB
AF1B LR A,7 Reverse sides and back 1 level
COM
LR 7,A
LIS H'F' Back 1 level
SL 4 Fast H'F0'
AFBB AS HL
LR HL,A
ABBB LR DC,H
PI RASC
ABBC JMP SELE
* Subroutine to back by 2's to non-passed board
AFBX LR K,P
LI -H'1'
ADC To ACTM location
LR Q,DC
AFB2 LR DC,Q
LIS H'1'
COM
SL 4 Back by H'20'
ADC
LR Q,DC
CLR
XM
BM AFB2 Go around again
LR A,QL
SR 4
LR 1,A Save to get new HL value
SL 1 2 bytes per entry, remember
DCI SCOR-4
ADC
LR Q,DC Q points back 2 from first passed
PK
* EVAL
* HLS used temporarily in multiply routine
EVAL LISU 4 Compute the material advantage term
LISL 6 Get to ACTM
LR A,I
LR MAT,A ACTM
LR A,I
LR HLS,A PASM
COM
INC
AS MAT
LR 3,A ACTM-PASM
BP EVA0
COM
INC
EVA0 LR 1,A |A-P|
LR A,MAT
AS HLS A+P
COM
INC -(A+P)
DCI AP20
AM Add initial value +11
SR 1 and divide by 2
LR HLS,A Save temporarily, multiply by
CLR by smaller pos. # in 1
LR MAT,A Product into MAT
LR A,1
EVA1 NI H'1' Is the rightmost bit a 1?
BZ EVA2 No
LR A,HLS
AS MAT
LR MAT,A
EVA2 LR A,HLS
SL 1
LR HLS,A
LR A,1
SR 1
LR 1,A
BNZ EVA1 Product is not complete
AS MAT
CI H'50' Maximum of 80 (later limited to 62)
BP EV21
LI H'50' Limit range to avoid CM trouble
LR MAT,A
EV21 CLR
XS 3 To get sign
LR A,MAT
BP EV22 Fixed 1/12/78
COM
INC
LR MAT,A Material advantage with sign
* Compute guard row credit
EV22 LISU PLOC
CLR
LR 3,A
XS 7
BZ EVG2 Black is active
LISL 4 Passive's (black's) guard byte
LIS H'A'
SL 4 Passive's guard bits
NS S Are pieces there?
LR 1,A
AI H'FF'
NS 1 Both of them?
BZ EVG1 No
CLR
COM Debit
LR 3,A
EVG1 LISL 3 Active's (red's) guard byte
LIS H'5' Active's guard bits
NS S Are active pieces there?
LR 1,A
AI H'FF'
NS 1 Both of them?
BZ EVG4 No
LR A,3
INC
LR 3,A Credit
BR EVG4
EVG2 LISL 7 Passive's (red's) guard byte
LIS H'5'
NS S Are pieces there?
LR 1,A
AI H'FF'
NS 1 Both of them?
BZ EVG3 No
CLR
COM Debit
LR 3,A
EVG3 LISL 0 Active's (black's) guard byte
LIS H'A'
SR 4 Active's guard bits
NS S Are pieces there?
LR 1,A
AI H'FF'
NS 1 Both of them?
BZ EVG4 No
LR A,3
INC Credit
LR 3,A
EVG4 LR A,3
SL 1 Credit of 2, 0 or -2
AS MAT Add to MAT
LR MAT,A
* Center credit with double credit for kings
CLR
LR 3,A
LISL 5 Start with passive
EVD0 LI H'66' These squares
NS I Are they occupied?
BZ EVD9 No
LR 5,A Save for kings
EVD1 LR 1,A Count them
DS 3
CLR
COM
AS 1
NS 1
BNZ EVD1
EVK0 LR A,IS
AI H'3' To kings (indexed 1 already)
LR IS,A
LR A,5
NS I And in kings
BZ EVD9
EVK1 LR 1,A
DS 3
CLR
COM
AS 1
NS 1
BNZ EVK1
EVD9 LR A,IS
AI -H'4'
LR IS,A
NI H'1' Can we consider next byte?
BZ EVD0 Yes
EVD2 LR A,3
AS MAT Debit for passive occupancy
LR MAT,A
CLR
LR 3,A
LISL 1 Now for active's bytes
EVD3 LI H'66' These squares
NS I Are they occupied?
BZ EVD6 No
LR 5,A
EVD5 LR 1,A Count them
DS 3
CLR
COM
AS 1
NS 1
BNZ EVD5
LR A,IS
AI H'7'
LR IS,A
LR A,5
NS I
BZ EVD6
EVK5 LR 1,A Count them
DS 3
CLR
COM
AS 1
NS 1
BNZ EVK5
EVD6 LR A,IS
AI -H'8'
LR IS,A
NI H'1' Can we consider the next byte?
BZ EVD3 Yes
EVD8 LR A,3
COM
INC Credit for active occupancy
AS MAT
LR MAT,A
BZ EVA3 No need to test further
BM EV10 May need to limit minimum
CI H'3E'
BP EVA3 No need to limit maximum
LI H'3E'
BR EV11
EV10 CI H'C1'
BM EVA3 Within limits
LI H'C2'
EV11 LR MAT,A
* Now the second SCOR term
EVA3 LR A,HL
SR 4
AI -H'2'
LR 5,A Save PLY
DCI MOBS Compute mobility term
AI -H'1'
ADC
LM Get earlier mobility
COM
INC
AS 2 Add current mobility
CI H'C' Difference limited to |12|
BP EVA4
LIS H'C'
EVA4 CI -H'C'
BM EVA5
LI -H'C'
EVA5 SL 1 Make room for ply term
SL 1 Would like to shift more
LR POT,A Save difference (and free 2)
CLR
AS MAT
BNZ EVA6
CLR
AS POT
EVA6 LR A,5 Get ply value
BM EVA7 Test sign of significant term
COM If pos. we add H'C'-PLY
INC
AI H'C'
BR EVA8
EVA7 AI -H'C' If neg. we add PLY-H'C'
EVA8 AS POT Add it in
LR POT,A Positional term with PLY
EVA9 LR A,HL
SR 4
SL 1
DCI SCOR-4
ADC
LR Q,DC
JMP AFTE AFT routine handles from here on
EMPT LR K,P Empty squares in O'51' thru O'54'
LISU ELOC with guard bytes in 50 and 55
LISL 0
CLR
LR S,A Make sure guard byte is empty
LISU PLOC Start with ACTIVE
LIS H'4'
LR 0,A
BR EMP3
EMP2 LR A,IS
AI H'30' Actually subtracting 16
LR IS,A
EMP3 LR A,S
LR 1,A
LR A,IS
AI 4
LR IS,A
LR A,S
AS 1
LR 1,A
LR A,IS
AI H'D' Add 13 get to the correct EMPTY locat
LR IS,A
LR A,1
COM Reverse 1's and 0's
LR S,A
DS 0
BNZ EMP2
LR A,I To index only
CLR
LR S,A Upper guard byte
PK
*
KING DC B'01011010' KING'S CROWN
DC B'00111100'
DC B'00011000'
REDP DC B'00111100' RED PIECE
DC B'01111110'
DC B'01111110'
DC B'01111110'
BLKP DC B'00111100' BLACK PIECE
DC B'01000010'
DC B'01000010'
DC B'01000010'
DC B'00111100'
*=*=*=*=*=*=*=*=*=*
*PLAYER WIN TUNE *
*=*=*=*=*=*=*=*=*=*
TUN2 DC H'4707'
DC H'78'
DC H'4003'
DC H'1F'
DC H'3C03'
DC H'1E'
DC H'3507'
DC H'1E'
DC H'3003'
DC H'1E'
DC H'2D03'
DC H'0F'
DC H'2D03'
DC H'0F'
DC H'2807'
DC H'5A'
DC H'3C03'
DC H'0F'
DC H'3507'
DC H'0F'
DC H'3003'
DC H'1E'
DC H'3C03'
DC H'1E'
DC H'3C03'
DC H'1E'
DC H'5007'
DC H'0F'
*=*=*=*=*=*=*=*=*=*=*
*COMPUTER WIN TUNE *
*=*=*=*=*=*=*=*=*=*=*
TUN1 DC H'2807'
DC H'2D'
DC H'2003'
DC H'0F'
DC H'1E03'
DC H'0F'
DC H'2003'
DC H'0F'
DC H'2403'
DC H'0F'
DC H'2807'
DC H'1E'
DC H'1E03'
DC H'0F'
DC H'2003'
DC H'1E'
DC H'2807'
DC H'2D'
DC H'2003'
DC H'0F'
DC H'1E03'
DC H'0F'
DC H'2003'
DC H'0F'
DC H'2807'
DC H'2D'
DC H'2003'
DC H'2D'
END END FOR ASSEMBLER